home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-textio.adb < prev    next >
Text File  |  1994-05-19  |  16KB  |  502 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                          A D A . T E X T _ I O                           --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.13 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Ada.Text_IO.Aux;
  26. package body Ada.Text_IO is
  27.  
  28.    procedure Unimplemented (Message : String) is
  29.    begin
  30.       Put (Message);
  31.       Put_Line (" not implemented yet");
  32.       raise Program_Error;
  33.    end Unimplemented;
  34.  
  35.    ---------------------
  36.    -- File Management --
  37.    ---------------------
  38.  
  39.    procedure Create (File : in out File_Type;
  40.                      Mode : in File_Mode := Out_File;
  41.                      Name : in String := "";
  42.                      Form : in String := "") renames Text_IO.Aux.Create;
  43.  
  44.    procedure Open (File : in out File_Type;
  45.                    Mode : in File_Mode;
  46.                    Name : in String;
  47.                    Form : in String := "") renames Text_IO.Aux.Open;
  48.  
  49.    procedure Close  (File : in out File_Type) renames Text_IO.Aux.Close;
  50.    procedure Delete (File : in out File_Type) renames Text_IO.Aux.Delete;
  51.  
  52.    procedure Reset (File : in out File_Type;
  53.                     Mode : in File_Mode)
  54.     renames Text_IO.Aux.Reset;
  55.  
  56.    procedure Reset (File : in out File_Type) is
  57.    begin
  58.       Text_IO.Aux.Reset (File, Text_IO.Aux.Mode (File));
  59.    end Reset;
  60.  
  61.    function Mode (File : in File_Type) return File_Mode
  62.      renames Text_IO.Aux.Mode;
  63.  
  64.    function Name (File : in File_Type) return String renames Text_IO.Aux.Name;
  65.    function Form (File : in File_Type) return String renames Text_IO.Aux.Form;
  66.  
  67.    function Is_Open (File : in File_Type) return Boolean
  68.      renames Text_IO.Aux.Is_Open;
  69.  
  70.    procedure Set_Input  (File : in File_Type) renames Text_IO.Aux.Set_Input;
  71.    procedure Set_Output (File : in File_Type) renames Text_IO.Aux.Set_Output;
  72.    procedure Set_Error (File : in File_Type) renames Text_IO.Aux.Set_Error;
  73.  
  74.    function Standard_Input return File_Type
  75.      renames Text_IO.Aux.Standard_Input;
  76.  
  77.    function Standard_Output return File_Type
  78.      renames Text_IO.Aux.Standard_Output;
  79.  
  80.    function Standard_Error return File_Type
  81.      renames Text_IO.Aux.Standard_Error;
  82.  
  83.    function Current_Input return File_Type renames Text_IO.Aux.Current_Input;
  84.    function Current_Output return File_Type renames Text_IO.Aux.Current_Output;
  85.    function Current_Error return File_Type renames Text_IO.Aux.Current_Error;
  86.  
  87.    --------------------------------------------
  88.    -- specification of line and page lengths --
  89.    --------------------------------------------
  90.  
  91.    procedure Set_Line_Length (File : in File_Type; To : in Count)
  92.      renames Text_IO.Aux.Set_Line_Length;
  93.  
  94.    procedure Set_Line_Length (To : in Count) is
  95.    begin
  96.       Text_IO.Aux.Set_Line_Length (Current_Output, To);
  97.    end Set_Line_Length;
  98.  
  99.    function Line_Length (File : in File_Type) return Count
  100.      renames Text_IO.Aux.Line_Length;
  101.  
  102.    function Line_Length return Count is
  103.    begin
  104.       return Text_IO.Aux.Line_Length (Current_Output);
  105.    end Line_Length;
  106.  
  107.    procedure Set_Page_Length (File : in File_Type; To : in Count)
  108.      renames Text_IO.Aux.Set_Page_Length;
  109.  
  110.    procedure Set_Page_Length (To : in Count) is
  111.    begin
  112.       Text_IO.Aux.Set_Page_Length (Current_Output, To);
  113.    end Set_Page_Length;
  114.  
  115.    function Page_Length (File : in File_Type) return Count
  116.      renames Text_IO.Aux.Page_Length;
  117.  
  118.    function Page_Length return Count is
  119.    begin
  120.       return Page_Length (Current_Output);
  121.    end Page_Length;
  122.  
  123.    ------------------------------------
  124.    -- Column, Line, and Page Control --
  125.    ------------------------------------
  126.  
  127.    procedure New_Line (File : in File_Type; Spacing : in Positive_Count := 1)
  128.      renames Text_IO.Aux.New_Line;
  129.  
  130.    procedure New_Line (Spacing : in Positive_Count := 1) is
  131.    begin
  132.       New_Line (Current_Output, Spacing);
  133.    end New_Line;
  134.  
  135.    procedure Skip_Line (File : in File_Type;
  136.                        Spacing : in Positive_Count := 1)
  137.      renames Text_IO.Aux.Skip_Line;
  138.  
  139.    procedure Skip_Line (Spacing : in Positive_Count := 1) is
  140.    begin
  141.       Skip_Line (Current_Input, Spacing);
  142.    end Skip_Line;
  143.  
  144.    function End_Of_Line (File : in File_Type) return Boolean
  145.      renames Text_IO.Aux.End_Of_Line;
  146.  
  147.    function End_Of_Line return Boolean is
  148.    begin
  149.       return End_Of_Line (Current_Input);
  150.    end End_Of_Line;
  151.  
  152.    procedure New_Page (File : in File_Type) renames Text_IO.Aux.New_Page;
  153.  
  154.    procedure New_Page is
  155.    begin
  156.       New_Page (Current_Output);
  157.    end New_Page;
  158.  
  159.    procedure Skip_Page (File : in File_Type) renames Text_IO.Aux.Skip_Page;
  160.  
  161.    procedure Skip_Page is
  162.    begin
  163.       Skip_Page (Current_Input);
  164.    end Skip_Page;
  165.  
  166.    function End_Of_Page (File : in File_Type) return Boolean
  167.      renames Text_IO.Aux.End_Of_Page;
  168.  
  169.    function End_Of_Page return Boolean is
  170.    begin
  171.       return End_Of_Page (Current_Input);
  172.    end End_Of_Page;
  173.  
  174.    function End_Of_File (File : in File_Type) return Boolean
  175.      renames Text_IO.Aux.End_Of_File;
  176.  
  177.    function End_Of_File return Boolean is
  178.    begin
  179.       return End_Of_File (Current_Input);
  180.    end End_Of_File;
  181.  
  182.    procedure Set_Col (File : in File_Type;
  183.                       To : in Positive_Count) renames Text_IO.Aux.Set_Col;
  184.  
  185.    procedure Set_Col (To : in Positive_Count) is
  186.    begin
  187.       Set_Col (Current_Output, To);
  188.    end Set_Col;
  189.  
  190.    procedure Set_Line (File : in File_Type;
  191.                        To : in Positive_Count) renames Text_IO.Aux.Set_Line;
  192.  
  193.    procedure Set_Line (To : in Positive_Count) is
  194.    begin
  195.       Set_Line (Current_Output, To);
  196.    end Set_Line;
  197.  
  198.    function Col (File : in File_Type) return Positive_Count
  199.      renames Text_IO.Aux.Col;
  200.  
  201.    function Col return Positive_Count is
  202.    begin
  203.       return Col (Current_Output);
  204.    end Col;
  205.  
  206.    function Line (File : in File_Type) return Positive_Count
  207.      renames Text_IO.Aux.Line;
  208.  
  209.    function Line return Positive_Count is
  210.    begin
  211.       return Line (Current_Output);
  212.    end Line;
  213.  
  214.    function Page (File : in File_Type) return Positive_Count
  215.      renames Text_IO.Aux.Page;
  216.  
  217.    function Page return Positive_Count is
  218.    begin
  219.       return Page (Current_Output);
  220.    end Page;
  221.  
  222.    -------------------------------
  223.    --  Characters Input-Output  --
  224.    -------------------------------
  225.  
  226.    procedure Get (File : in File_Type;
  227.                   Item : out Character) is
  228.    begin
  229.       Text_IO.Aux.The_File := File;
  230.       Text_IO.Aux.Get (Item);
  231.    end Get;
  232.  
  233.  
  234.    procedure Get (Item : out Character) is
  235.    begin
  236.       Get (Current_Input, Item);
  237.    end Get;
  238.  
  239.    procedure Put (File : in File_Type;
  240.                   Item : in Character) is
  241.    begin
  242.       Text_IO.Aux.The_F